PC Plus SuperCD (UK) 1997 May/PC Plus Super CD Issue 127 (May 1997).iso/handson/handson.exe/PIECRUST.BAS

BASIC Source File | 1997-05-01 | 53.4 KB | 2,413 lines

'<->
DEFINT A-Z
DECLARE SUB ziDragging ()
' Return if mouse active and still dragging, or else exhausted

DECLARE SUB ziDrawBank (FromButton, ToButton)
' Draw a bank of buttons (using Bank array)

DECLARE SUB ziExhaust ()
' Return when no keystrokes and no mouse buttons

DECLARE SUB ziLoadFont (Font$)
' Load a specified font

DECLARE SUB ziLocateMCursor (XCoord, YCoord)
' Locate mouse cursor to a named point

DECLARE SUB ziMouseOnButton (FromButton, ToButton)
' Sets FoundButton

DECLARE SUB ziPublish (Printstring$, size, italic)
' Print a string at graphics cursor (advanced)
'   Size   = magnitude (per 8 pixels)
'   Italic = +1 to make italic
'          = +2 to make overprint (no background)

DECLARE SUB ziPublishHere (row, col, Printstring$, size, italic)
' Print a string at the specified text position

DECLARE SUB ziRadio (Button, FromButton, ToButton)
' Set one button in a Bank, resetting the rest

DECLARE SUB ziReadField (Min, Max, Permitted$)
' Read a field at the current TCursor location
'   Permitted$ contains:
'     * - any characters
'     . - allow one full-stop (as decimal)
'     A - auto-enter (when filled)
'     C - capitalise letters
'     E - ESC allowed to finish (skip) field
'     J - justify (especially for numeric)
'     N - numerics
'     P - password-type display
'     S - space
'     X - alphabetic
'     Y - Y or N (upper or lower)

DECLARE SUB ziSetMCursorVis (Status)
' Set visibility of mouse cursor
'   Status = 0 for OFF
'            1 for ON
'            2 for ENQUIRE (set MCursorVis)
'           10 for TEMPORARILY OFF
'           11 for RESTORED (set MCursorVis)

DECLARE SUB ziWander (Timeout!)
' Timeout  = in seconds (0 = none)
' Response =   0 = (0:00) timed out
'              n = (0:n)  displacement into Allowed$

' key           &h01xx  &h02xx  &h04xx  &h08xx  &h10xx  &h20xx  &h40xx
'                plain   CTRL    shift   Mouse    Fn   CTRL-Fn  shift-Fn

' Enter      0    *       *       -      double    -      -       -
' (left)     1    *       *       -      left     F1     ^F1     +F1
' (right)    2    *       *       -      right    F2     ^F2     +F2
' (up)       3    *       -       -      both     F3     ^F3     +F3
' (down)     4    *       -       -    leftdrag   F4     ^F4     +F4

' Backspace  5    *       *       -    rightdrag  F5     ^F5     +F5
' Home       6    *       *       -    bothdrag   F6     ^F6     +F6
' End        7    *       *       -       -       F7     ^F7     +F7

' PgUP       8    *       *       -       -       F8     ^F8     +F8
' PgDN       9    *       *       -       -       F9     ^F9     +F9

' Tab       10    *       -       *       -       F10    ^F10    +F10
' Escape    11    *       -       -       -       F11    ^F11    +F11
'           12    -       -       -       -       F12    ^F12    +F12

' Allowed$  = other allowed strokes
' (Note:  DClick is a flag permitting Double-clicks of mouse - slower!)

DEFINT A-Z
DECLARE SUB zsAlignGCursor ()
' Align graphic cursor to same as text cursor
'  - sets Row, Col, GXloc, GYloc

DECLARE SUB zsAlignTCursor ()
' Align text cursor to same as graphic cursor
'  - sets Row, Col, GXloc, GYloc

DECLARE SUB zsLocateGCursor (XCoord, YCoord)
' Locate graphic cursor to a named point

DECLARE SUB zsPastel (XCoord, YCoord, Wide, Deep, colour1, colour2)
' Colour the defined oblong with a pastel mix of two colours
'  Deep = 0 or 1 - square
'       = n      - Y-pixel depth

DECLARE SUB zsSetScrnMode (Mode, HiRows, HiCols)
' Mode = 9, 12 or 13
' HiRows = 1 to make high number of rows
' HiCols = 1 to make high number of cols (80)
' Set SCREEN parameters and blank the screen
'  - sets ScrnMode, Xmax, Ymax, Rows, Cols, XYRatio!
'  - uses FG and optionally BG (colours)

DECLARE SUB zsSubstitute (XCoord, YCoord, Wide, Deep, colour1, colour2)
' Substitute one colour with another within the defined oblong
'  Deep = 0 or 1 - square
'       = n      - Y-pixel depth

DECLARE SUB zzAlphaSort (Table$())
' Sort alphabetically the strings in the table; limited by " SortCount"

DECLARE SUB zzBasicInt (IntType)
' Execute interrupt (params in REGS.AX etc)

DECLARE SUB zzChangeDir (Directory$)
' Change to a particular directory
'  -sets Directory$; eg "." will be changed to current directory
' if error occurs, Directory$ is returned as "?"

DECLARE SUB zzChangeDrive (Drive$)
' Change to a particular drive
' if Drive$ is empty on input, current drive is returned
' if error occurs, Drive$ is returned as "?"

DECLARE SUB zzCritOff ()
' turns off Critical Error Handling

DECLARE SUB zzCritOn ()
' restores normal Critical Error Handling

DECLARE SUB zzFileSelectBox (Pattern$)
' File Select Box function to choose an input file

DECLARE SUB zzInPath (Field$)
' Return full path to a file (in same string)

DECLARE SUB zzSearchD (Pattern$)
' Search for DIRECTORIES matching the pattern
'  - sets Directories and Directories$()

DECLARE SUB zzSearchF (Pattern$)
' Search for FIILENAMES matching the pattern
'  - sets FileNames and FileNames$()

DECLARE SUB zzValidate (Directory$)
' validate the named path and return its full
'   (unqualified) name, including drive
' if error occcurs, Directory$ is returned as "?"

'================================================
'/  UK copyright (c) 1997 by Future Publishing
'/
'/
'/
'/
'================================================
TYPE REGISTERS
  AX AS INTEGER
  BX AS INTEGER
  CX AS INTEGER
  DX AS INTEGER
  DS AS INTEGER
  SI AS INTEGER
  ES AS INTEGER
  DI AS INTEGER
  FL AS INTEGER
END TYPE

TYPE Buttons
  Xloc AS INTEGER
  Yloc AS INTEGER
  Wide AS INTEGER
  Deep AS INTEGER
'  0 = checkbutton
'  1 = square sculptured
'  n = Y-pixels deep
  State AS INTEGER
'  0 = off
'  1 = on
  Active AS INTEGER
'  0 = inactive
'  1 = active
END TYPE

CONST Pi! = 3.14159
CONST Ex! = 2.71828
CONST DegToRad! = .0174533
CONST RadToDeg! = 57.2958

CONST ziNoShift = &H1
CONST ziCTRL = &H2
CONST ziShift = &H4
CONST ziMouse = &H8
CONST ziFn = &H10
CONST ziCTRLFn = &H20
CONST ziShiftFn = &H40

CONST ziL = 1
CONST ziR = 2
CONST ziUp = 3
CONST ziDn = 4
CONST ziBS = 5
CONST ziHome = 6
CONST ziEnd = 7
CONST ziPgUp = 8
CONST ziPgDn = 9
CONST ziTab = 10
CONST ziEsc = 11

CONST ziDbl = 0
CONST ziBoth = 3
CONST ziLDrag = 4
CONST ziRDrag = 5
CONST ziBothDrag = 6

DIM SHARED Regs AS REGISTERS
DIM SHARED Bank(20) AS Buttons
DIM SHARED Bad, Module$
DIM SHARED Mouse, MCursorVis, MXloc, MYloc
DIM SHARED DClick
DIM SHARED ScrnMode, bg, fg, TCursor
DIM SHARED Xmax, Ymax, GXloc, GYloc, XYratio!
DIM SHARED Rows, Cols, row, col
DIM SHARED Allowed$, Field$
DIM SHARED FoundButton
DIM SHARED Font(255, 7)
DIM SHARED Response, HResponse, LResponse
DIM SHARED SortCount
REDIM SHARED Directories$(500)
REDIM SHARED FileNames$(500)
DIM SHARED Directories, FileNames

DIM SHARED IRET AS STRING * 3
IRET = CHR$(&HB0) + CHR$(&H0) + CHR$(&HCF)
DIM SHARED CritSeg, CritPtr, CritCount

'++++++++++++++++++++++++
RANDOMIZE TIMER
ON ERROR GOTO RESUMENEXT
RESUMENEXT:
  IF ERR = 255 THEN
    CLS
    BEEP
    PRINT "Cannot find module "; Module$
    SLEEP
    SYSTEM
  END IF
  IF ERR THEN
    Bad = ERR
    RESUME NEXT
  END IF
Regs.AX = &H3524
CALL zzBasicInt(&H21)
CritSeg = Regs.ES
CritPtr = Regs.BX
'++++++++++++++++++++++++
' Test for presence of a mouse
Mouse = 0
Regs.AX = 0
CALL zzBasicInt(&H33)
IF Regs.AX THEN
  Mouse = 1
  CALL ziSetMCursorVis(0)
END IF
'++++++++++++++++++++++++
' Load the ASCII font
CALL ziLoadFont("Ascii8x8")
'/==================================/'
'/  End of Standard Piecrust code   /'
'/==================================/'
'<+>

'<->
'<p>
'++++++++++++++++++++++++
SUB ziDragging

  IF Mouse AND MCursorVis THEN
    SELECT CASE Response
    CASE 2052 TO 2054
      Regs.AX = 3
      CALL zzBasicInt(&H33)
      IF Regs.BX = Response - 2051 THEN
    EXIT SUB
      END IF
    END SELECT
  END IF
  CALL ziExhaust

END SUB

'<p>
'++++++++++++++++++++++++
SUB ziDrawBank (FromButton, ToButton)

  CALL ziSetMCursorVis(10)

  FOR i = FromButton TO ToButton

    IF Bank(i).Active THEN

      IF Bank(i).State THEN
    colour1 = 8
      ELSE
    colour1 = 15
      END IF
      colour2 = colour1 XOR 7

      XCoord = Bank(i).Xloc
      YCoord = Bank(i).Yloc
      XWidth = Bank(i).Wide
      YDepth = Bank(i).Deep
      X2Coord = XCoord + XWidth

      IF YDepth THEN
    IF YDepth = 1 THEN
      Y2Coord = YCoord + XWidth / XYratio!
    ELSE
      Y2Coord = YCoord + YDepth
    END IF
    LINE (XCoord, YCoord)-(X2Coord - 1, YCoord), colour1
    LINE (XCoord, YCoord)-(XCoord, Y2Coord - 1), colour1
    LINE (XCoord + 1, Y2Coord)-(X2Coord, Y2Coord), colour2
    LINE (X2Coord, YCoord)-(X2Coord, Y2Coord), colour2
      ELSE
    A = XWidth \ 2
    B = A / XYratio!
    C = XCoord + A
    D = YCoord + B

    LINE (XCoord, YCoord)-(C + A, D + B), 7, BF

    CIRCLE (C, D), A, 8
    CIRCLE (C, D), A - 1, 8
    PAINT (C, D), 7, 7
    IF Bank(i).State THEN
      CIRCLE (C, D), XWidth \ 3, 8
      PAINT (C, D), 8, 8
    END IF
      END IF
    END IF

  NEXT

  CALL ziSetMCursorVis(11)

END SUB

'<p>
'++++++++++++++++++++++++
SUB ziExhaust

  DO
    x$ = INKEY$
  LOOP WHILE LEN(x$)

  IF Mouse AND MCursorVis THEN
    DO
      Regs.AX = 3
      CALL zzBasicInt(&H33)
    LOOP WHILE (Regs.BX AND 3)
  END IF
  Response = 0
END SUB

'<p>
'++++++++++++++++++++++++
SUB ziLoadFont (Font$)

  DEF SEG = VARSEG(Font(0, 0))

  Module$ = Font$ + ".OVL"
  CALL zzInPath(Module$)
  IF Module$ = "" THEN
    Module$ = Font$ + ".OVL"
    ERROR 255
  ELSE
    BLOAD Module$, VARPTR(Font(0, 0))
  END IF

  DEF SEG

END SUB

'<p>
'++++++++++++++++++++++++
SUB ziLocateMCursor (XCoord, YCoord)

  IF Mouse THEN
    MXloc = XCoord
    MYloc = YCoord
    Regs.AX = 4
    Regs.CX = XCoord
    Regs.DX = YCoord
    CALL zzBasicInt(&H33)
    CALL ziSetMCursorVis(1)
  END IF

END SUB

'<p>
'++++++++++++++++++++++++
SUB ziMouseOnButton (FromButton, ToButton)

  FoundButton = 0
  FOR i = FromButton TO ToButton
    IF Bank(i).Active THEN
      IF Bank(i).Deep < 2 THEN
    j = Bank(i).Wide / XYratio!
      ELSE
    j = Bank(i).Deep
      END IF
      IF MXloc > Bank(i).Xloc THEN
    IF MXloc < Bank(i).Xloc + Bank(i).Wide THEN
      IF MYloc > Bank(i).Yloc THEN
        IF MYloc < Bank(i).Yloc + j THEN
          FoundButton = i
          EXIT SUB
        END IF
      END IF
    END IF
      END IF
    ELSE
      EXIT SUB
    END IF
  NEXT

END SUB

'<p>
'++++++++++++++++++++++++
SUB ziPublish (Printstring$, size, italic)

  CALL ziSetMCursorVis(10)

  xx = POINT(0)
  yy = POINT(1)
  IF size THEN
    Scale = size
  ELSE
    Scale = 1
  END IF

  LenString = LEN(Printstring$)

  ExpScale = 8 * Scale
  limxx = xx + ExpScale * LenString - 1
  limyy = yy + ExpScale - 1

  IF italic AND 1 THEN
    limxx = limxx + 4 * Scale
  END IF


  IF italic AND 2 THEN
  ELSE
    LINE (xx, yy)-(limxx, limyy), bg, BF
  END IF


  FOR A = 0 TO LenString - 1
    x = ASC(MID$(Printstring$, A + 1, 1))
    B = xx + ExpScale * A
    FOR y = 0 TO 7
      C = Font(x, y)
      D = y * Scale
      e = yy + D
      IF italic AND 1 THEN
    F = B + 4 * Scale - (D + Scale - 1) \ 2 - 1
      ELSE
    F = B
      END IF
      g = 128
      DO
    IF C AND g THEN
      FOR h = 0 TO Scale - 1
        FOR i = 0 TO Scale - 1
          PSET (F + h, e + i), fg
        NEXT
      NEXT
    END IF
    F = F + Scale
    g = g \ 2
      LOOP UNTIL g = 0
    NEXT
  NEXT
  CALL zsLocateGCursor(limxx + 1, yy)

  CALL ziSetMCursorVis(11)

END SUB

SUB ziPublishHere (row, col, Printstring$, size, italic)

 IF row + col > 0 THEN
  LOCATE row, col
 END IF
 CALL zsAlignGCursor
 CALL ziPublish(Printstring$, size, italic)
 CALL zsAlignTCursor

END SUB

'<p>
'++++++++++++++++++++++++
SUB ziRadio (Button, FromButton, ToButton)

  IF Button >= FromButton THEN
    IF Button <= ToButton THEN
      FOR A = FromButton TO ToButton
    Bank(A).State = 0
      NEXT
    END IF
  END IF

  Bank(Button).State = 1
  CALL ziDrawBank(FromButton, ToButton)

END SUB

'<p>
'++++++++++++++++++++++++
SUB ziReadField (Min, Max, Permitted$)

  CALL ziSetMCursorVis(10)

  atRow = CSRLIN
  atCol = POS(x)
  Field$ = ""
  PRINT CHR$(219); SPACE$(Max);
  Rules$ = UCASE$(Permitted$)

  brake = 1
  WHILE brake
    x$ = ""
    WHILE LEN(x$) = 0
      x$ = INKEY$
    WEND
    IF INSTR(Rules$, "C") THEN x$ = UCASE$(x$)
    oldLen = LEN(Field$)
    Good = 0
    IF INSTR(Rules$, ".") THEN
      IF x$ = "." THEN
    IF INSTR(Field$, ".") = 0 THEN
      Good = 1
    END IF
      END IF
    END IF
    IF INSTR(Rules$, "N") THEN
      IF INSTR("0123456789", x$) THEN
    Good = 1
      END IF
    END IF
    IF INSTR(Rules$, "S") THEN
      IF x$ = " " THEN
    Good = 1
      END IF
    END IF
    IF INSTR(Rules$, "X") THEN
      IF INSTR("ABCDEFGHIJKLMNOPQRSTUVWXYZ", UCASE$(x$)) THEN
    Good = 1
      END IF
    END IF
    IF INSTR(Rules$, "Y") THEN
      IF INSTR("YyNy", x$) THEN
    Good = 1
      END IF
    END IF
    IF Good THEN
      Field$ = Field$ + x$
      IF INSTR(Field$, ".") THEN
    NewMax = Max + 1
      ELSE
    NewMax = Max
      END IF
      Field$ = MID$(Field$, 1, NewMax)
    END IF

    ' handle Bkspace
    IF ASC(x$) = 8 AND LEN(Field$) THEN
      Field$ = MID$(Field$, 1, LEN(Field$) - 1)
    END IF

    Signif$ = Field$ + "X"
    WHILE INSTR(" 0", MID$(Signif$, 1, 1))
      Signif$ = MID$(Signif$, 2)
    WEND
    IF INSTR(Signif$, ".") THEN
      SignifLen = LEN(Signif$) - 2
    ELSE
      SignifLen = LEN(Signif$) - 1
    END IF

    ' handle Enter
    IF ASC(x$) = 13 AND SignifLen >= Min THEN
      oldLen = LEN(Field$) + 1
      brake = 0
    END IF

    ' handle Esc
    IF ASC(x$) = 27 THEN
      LOCATE atRow, atCol
      PRINT CHR$(219); SPACE$(Max);
      Field$ = ""
      IF INSTR(Rules$, "E") THEN
    EXIT SUB
      END IF
    END IF

    ' reprint if change, or beep if no change
    IF oldLen = LEN(Field$) THEN
      BEEP
    ELSE
      LOCATE atRow, atCol
      IF INSTR(Rules$, "P") THEN
    PRINT STRING$(LEN(Field$), 254); CHR$(219); " ";
      ELSE
    PRINT Field$; CHR$(219); " ";
      END IF
    END IF

    ' check for auto-Enter
    IF INSTR(Rules$, "A") THEN
      IF SignifLen = Max THEN
    brake = 0
      END IF
    END IF
  WEND

  ' justify if required
  IF INSTR(Rules$, "J") THEN
    WHILE MID$(Field$, 1, 1) = "0"
      Field$ = MID$(Field$, 2)
    WEND
    Field$ = RIGHT$(SPACE$(NewMax) + Field$, NewMax)
  END IF

  ' reprint, deleting the cursor
  LOCATE atRow, atCol
  IF INSTR(Rules$, "P") THEN
    PRINT STRING$(LEN(Field$), 254); " ";
  ELSE
    PRINT Field$; " ";
  END IF

  CALL ziSetMCursorVis(11)

END SUB

'<p>
'++++++++++++++++++++++++
SUB ziSetMCursorVis (Status) STATIC

  IF Mouse THEN
    SELECT CASE Status
    CASE 0
      IF MCursorVis THEN
       Regs.AX = 2
       CALL zzBasicInt(&H33)
      END IF
    CASE 1
      Regs.AX = 1
      CALL zzBasicInt(&H33)
    CASE 10
      Regs.AX = &H2A
      CALL zzBasicInt(&H33)
      IF Regs.AX = 0 THEN
    TempFlag = 1
    Regs.AX = 2
    CALL zzBasicInt(&H33)
      ELSE
    TempFlag = 0
      END IF
    CASE 11
      IF TempFlag THEN
    Regs.AX = 1
    CALL zzBasicInt(&H33)
      END IF
    END SELECT
    Regs.AX = &H2A
    CALL zzBasicInt(&H33)
    IF Regs.AX = 0 THEN
      MCursorVis = 1
    ELSE
      MCursorVis = 0
    END IF
  END IF
END SUB

'<p>
'++++++++++++++++++++++++
SUB ziWander (Timeout!)

  IF Timeout! = 0 THEN
    WatchFor! = TIMER + 3600
  ELSE
    WatchFor! = TIMER + Timeout!
  END IF

  Response = 0

  DO
    x$ = INKEY$
    IF LEN(x$) THEN
      SELECT CASE LEN(x$)
      CASE 1
    A = INSTR(Allowed$, x$)
    IF A THEN
      Response = A
      EXIT DO
    END IF
    SELECT CASE ASC(x$)
    CASE 8: Response = 261
    CASE 9: Response = 266
    CASE 10: Response = 512
    CASE 13: Response = 256
    CASE 27: Response = 267
    CASE 127: Response = 517
    END SELECT
    IF Response THEN
      EXIT DO
    END IF
      CASE 2
    Rightmost = ASC(RIGHT$(x$, 1))
    SELECT CASE Rightmost
    CASE 15: Response = 1019
    CASE 59 TO 68
      Response = 4038
    CASE 72: Response = 187
    CASE 71 TO 73
      Response = 191
    CASE 75: Response = 182
    CASE 77: Response = 181
    CASE 80: Response = 180
    CASE 79 TO 81
      Response = 184
    CASE 84 TO 93
      Response = 16301
    CASE 94 TO 103
      Response = 8099
    CASE 115 TO 116
      Response = 398
    CASE 117: Response = 402
    CASE 118: Response = 403
    CASE 119: Response = 399
    CASE 127: Response = 390
    CASE 132: Response = 388
    CASE 133 TO 134
      Response = 3974
    CASE 135 TO 136
      Response = 16260
    CASE 137 TO 138
      Response = 8066
    END SELECT
    IF Response THEN
      Response = Response + Rightmost
      EXIT DO
    END IF
      END SELECT
    END IF

    IF Mouse AND MCursorVis THEN
      Regs.AX = 3
      CALL zzBasicInt(&H33)
      SELECT CASE Regs.BX
      CASE 1 TO 3
    Response = 2048 + Regs.BX
    nowtime! = TIMER
    DO
      Regs.AX = 3
      CALL zzBasicInt(&H33)
      IF Regs.BX = 0 THEN EXIT DO
    LOOP UNTIL TIMER - nowtime! > .3
    IF Regs.BX = Response - 2048 THEN
      Response = Response + 3
    ELSE
      IF Regs.BX = 0 AND Response = 2049 AND DClick THEN
        nowtime! = TIMER
        DO
          Regs.AX = 3
          CALL zzBasicInt(&H33)
          IF Regs.BX = 1 THEN EXIT DO
        LOOP UNTIL TIMER - nowtime! > .3
        IF Regs.BX = 1 THEN
          Response = 2048
          CALL ziExhaust
        END IF
      END IF
      IF Regs.BX = 3 THEN
        Response = 2051
      END IF
    END IF
      END SELECT
      IF Response THEN
    MXloc = Regs.CX
    MYloc = Regs.DX
    EXIT DO
      END IF
    END IF

  LOOP UNTIL WatchFor! < TIMER
  HResponse = Response \ 256
  LResponse = Response MOD 256

END SUB

'<p>
'++++++++++++++++++++++++
SUB zsAlignGCursor

  row = CSRLIN
  col = POS(0)
  GXloc = (col - 1) * ((Xmax + 1) \ Cols)
  GYloc = (row - 1) * ((((Ymax + 1) \ Rows) * Rows + 1) \ Rows)
  CALL zsLocateGCursor(GXloc, GYloc)

END SUB

'<p>
'++++++++++++++++++++++++
SUB zsAlignTCursor

  GXloc = POINT(0)
  GYloc = POINT(1)
  A = (Xmax + 1) / Cols
  B = (Ymax + 1) / Rows
  col = (GXloc + A - 1) \ A + 1
  row = (GYloc + B - 1) \ B + 1
  LOCATE row, col
  CALL zsAlignGCursor

END SUB

'<p>
'++++++++++++++++++++++++
SUB zsLocateGCursor (XCoord, YCoord)

  GXloc = XCoord
  GYloc = YCoord
  PSET (GXloc, GYloc), POINT(GXloc, GYloc)

END SUB

'<p>
'++++++++++++++++++++++++
SUB zsPastel (XCoord, YCoord, Wide, Deep, colour1, colour2)

  CALL ziSetMCursorVis(10)

  IF Deep < 2 THEN
    A = Wide / XYratio!
  ELSE
    A = Deep
  END IF

  LINE (XCoord, YCoord)-(XCoord + Wide - 1, YCoord + A - 1), colour1, BF
  FOR B = XCoord TO XCoord + Wide - 1 STEP 2
    LINE (B, YCoord)-(B, YCoord + A - 1), colour2, , &H5555
  NEXT
  FOR B = XCoord + 1 TO XCoord + Wide - 1 STEP 2
    LINE (B, YCoord)-(B, YCoord + A - 1), colour2, , &HAAAA
  NEXT

  CALL ziSetMCursorVis(11)

END SUB

'<p>
'++++++++++++++++++++++++
SUB zsSetScrnMode (Mode, HiRows, HiCols)

  CALL ziSetMCursorVis(10)

  ScrnMode = Mode
  SELECT CASE Mode
  CASE 9
    SCREEN 9
    IF HiRows THEN
      Rows = 43
    ELSE
      Rows = 25
    END IF
    Xmax = 639
    Ymax = 349
  CASE 12
    SCREEN 12
    IF HiRows THEN
      Rows = 60
    ELSE
      Rows = 30
    END IF
    Xmax = 639
    Ymax = 479
  CASE 13
    SCREEN 13
    Rows = 25
    Cols = 40
    Xmax = 319
    Ymax = 199
  CASE ELSE
    RETURN
  END SELECT

  IF Mode <> 13 THEN
    IF HiCols THEN
      Cols = 80
    ELSE
      Cols = 40
    END IF
  END IF
  WIDTH Cols, Rows
  CLS
  SELECT CASE Mode
  CASE 9
    COLOR fg, 0
  CASE ELSE
    COLOR fg
  END SELECT

  LINE (0, 0)-(Xmax, Ymax), bg, BF
  LOCATE 1, 1, 0
  PSET (0, 0), bg
  XYratio! = .75 * (Xmax + 1) / (Ymax + 1)

  CALL ziSetMCursorVis(11)

END SUB

'<p>
'++++++++++++++++++++++++
SUB zsSubstitute (XCoord, YCoord, Wide, Deep, colour1, colour2)

  CALL ziSetMCursorVis(10)

  IF Deep < 2 THEN
    A = Wide / XYratio!
  ELSE
    A = Deep
  END IF
  FOR B = XCoord TO XCoord + Wide - 1
    FOR C = YCoord TO YCoord + A - 1
      IF POINT(B, C) = colour1 THEN
    PSET (B, C), colour2
      END IF
    NEXT
  NEXT

  CALL ziSetMCursorVis(11)

END SUB

'<p>
'++++++++++++++++++++++++
SUB zzAlphaSort (SortData$())

 DIM SortPointers(SortCount, 2)

 FOR i = 2 TO SortCount
  j = 1

  DO
   k = j
   IF SortData$(i) < SortData$(j) THEN
    j = SortPointers(j, 1)
   ELSE
    j = SortPointers(j, 2)
   END IF
  LOOP WHILE j <> 0

  IF SortData$(i) < SortData$(k) THEN
   SortPointers(k, 1) = i
  ELSE
   SortPointers(k, 2) = i
  END IF
 NEXT

 SortPointers(0, 1) = 1


 FOR i = 1 TO SortCount
  j = 0
  DO WHILE SortPointers(j, 1) <> 0
   k = j
   j = SortPointers(j, 1)
  LOOP
  SortPointers(k, 1) = SortPointers(j, 2)

  SWAP SortData$(i), SortData$(j)
  SWAP SortPointers(i, 1), SortPointers(j, 1)
  SWAP SortPointers(i, 2), SortPointers(j, 2)

  FOR k = 0 TO SortCount
   FOR l = 1 TO 2
    IF SortPointers(k, l) = i THEN SortPointers(k, l) = j
   NEXT
  NEXT
 NEXT

END SUB

'<p>
'++++++++++++++++++++++++
SUB zzBasicInt (IntType) STATIC

  DIM ASM(54)
  DEF SEG = VARSEG(ASM(0))

  IF ASM(1) = 0 THEN
    Module$ = "BASICINT.OVL"
    CALL zzInPath(Module$)
    IF Module$ = "" THEN
      Module$ = "BASICINT.OVL"
      ERROR 255
    ELSE
      BLOAD Module$, VARPTR(ASM(0))
    END IF
  END IF

  CALL ABSOLUTE(Regs, IntType, VARPTR(ASM(0)))

  DEF SEG

END SUB

'<p>
'++++++++++++++++++++++++
SUB zzChangeDir (Directory$)
 DIM str AS STRING * 65

 str = LTRIM$(RTRIM$(UCASE$(Directory$))) + CHR$(0)
 IF MID$(str, 2, 1) = ":" THEN
  curdrive$ = MID$(str, 1, 1)
  str = MID$(str, 3)
 ELSE
  Regs.AX = &H1900
  CALL zzBasicInt(&H21)
  curdrive$ = CHR$(65 + (Regs.AX AND 255))
 END IF
 IF MID$(str, 1, 1) = CHR$(0) THEN
  GOSUB zzChangeDirAA
  EXIT SUB
 END IF
 str = curdrive$ + ":" + str
 Regs.AX = &H3B00
 Regs.DS = VARSEG(str)
 Regs.DX = VARPTR(str)
 CALL zzBasicInt(&H21)
 IF (Regs.FL AND 256) = 256 THEN
  Directory$ = ""
 ELSE
  GOSUB zzChangeDirAA
 END IF
 EXIT SUB

zzChangeDirAA:
  Regs.AX = &H4700
  Regs.DX = ASC(curdrive$) - 64
  Regs.DS = VARSEG(str)
  Regs.SI = VARPTR(str)
  CALL zzBasicInt(&H21)
  i = INSTR(str, CHR$(0))
  Directory$ = curdrive$ + ":\" + MID$(str, 1, i - 1)
  RETURN
END SUB

'<p>
'++++++++++++++++++++++++
SUB zzChangeDrive (Drive$)

 CALL zzCritOff
 GOSUB zzChangeDriveProcess
 CALL zzCritOn

 EXIT SUB

zzChangeDriveProcess:

 Drive$ = LTRIM$(RTRIM$(UCASE$(Drive$)))
 IF LEN(Drive$) = 0 THEN
  Regs.AX = &H1900
  CALL zzBasicInt(&H21)
  Drive$ = CHR$(65 + (Regs.AX AND 255)) + ":"
  RETURN
 END IF

 IF LEN(Drive$) = 1 THEN Drive$ = Drive$ + ":"
 IF LEN(Drive$) > 2 THEN Drive$ = "?"

 IF MID$(Drive$, 2, 1) = ":" THEN
  drv = ASC(Drive$)
  Drive$ = "?"
  IF drv < 65 THEN RETURN
  IF drv > 90 THEN RETURN
  drv = drv - 65

' establish whether this is a shared drive

  Regs.AX = &H440E
  Regs.BX = drv + 1
  CALL zzBasicInt(&H21)
  IF (Regs.FL AND 256) = 256 THEN
   Regs.AX = 0
  END IF
  Regs.AX = Regs.AX AND 255
  IF Regs.AX <> 0 THEN
   IF Regs.AX <> drv + 1 THEN
    drv = Regs.AX - 1
   END IF
  END IF

' establish whether this is a valid drive

  Regs.AX = &H1C00
  Regs.DX = drv + 1
  CALL zzBasicInt(&H21)
  IF (Regs.AX AND 255) = 255 THEN RETURN

' now change to it

  Regs.AX = &HE00
  Regs.DX = drv
  CALL zzBasicInt(&H21)

  Drive$ = CHR$(65 + drv) + ":"


 ELSE
  Drive$ = "?"
 END IF
 RETURN

END SUB

SUB zzCritOff

 Regs.AX = &H2524
 Regs.DS = VARSEG(IRET)
 Regs.DX = VARPTR(IRET)
 CALL zzBasicInt(&H21)
 CritCount = CritCount + 1

END SUB

SUB zzCritOn

 CritCount = CritCount - 1
 IF CritCount = 0 THEN
  Regs.AX = &H2524
  Regs.DS = CritSeg
  Regs.DX = CritPtr
  CALL zzBasicInt(&H21)
 END IF

END SUB

'<p>
'++++++++++++++++++++++++
SUB zzFileSelectBox (Pattern$)

DIM Devices(26)  ';valid devices have a non-zero value
DIM validDevs(27)

DIM parts$(11) ';ten deep is allowed
DIM Dirs$(200) ';lots of subdirectories
DIM Files$(200) ';lots of files
DIM str AS STRING * 65

 CALL zzCritOff
 GOSUB zzFileSelectBoxProcess
 CALL zzCritOn

 EXIT SUB

zzFileSelectBoxProcess:

' create the screen

  IF screendone = 0 THEN
   bg = 7: fg = 15
   CALL zsSetScrnMode(9, 1, 1)
   fg = 0
   CALL ziPublishHere(3, 34, "Select a File", 1, 3)
   Stuff$ = "(Please Wait)"
   fg = 14
   GOSUB zzFileSelectBoxDD

' print the headers

   fg = 8
   CALL ziPublishHere(42, 17, "Use left & right arrow keys to change columns", 0, 1)
  END IF
  screendone = 1

  fg = 8: CALL ziPublishHere(8, 2, "Drives", 2, 1): fg = 0
  LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B


  IF NoDriveSelection = 0 THEN
   dev = 0: GOSUB zzFileSelectBoxAA

' find the DTA

   Regs.AX = &H2F00
   CALL zzBasicInt(&H21)
   DTAseg = Regs.ES
   DTAptr = Regs.BX

' establish the existing devices

   MaxDevs = 0
   FOR i = 1 TO 26
    Devices(i) = 0
    validDevs(i) = 0
    Regs.AX = &H440E
    Regs.BX = i
    CALL zzBasicInt(&H21)
    IF (Regs.FL AND 256) = 256 THEN
     Regs.AX = 0
    END IF
    Regs.AX = Regs.AX AND 255
    IF (Regs.AX = 0) OR (Regs.AX = i) THEN
     Regs.AX = &H1C00
     Regs.DX = i
     CALL zzBasicInt(&H21)
     IF (Regs.AX AND 255) <> 255 THEN
      MaxDevs = MaxDevs + 1
      Devices(i) = MaxDevs '; set the crossreference
      validDevs(MaxDevs) = i
     END IF
    END IF
   NEXT

' print the valid drives as a list

   fg = 0
   FOR i = 1 TO MaxDevs
    x$ = CHR$(64 + validDevs(i)) + ":"
    CALL ziPublishHere(10 + i + i, 7, x$, 1, 0)
   NEXT
  END IF
  LINE (GXloc - 16, GYloc + 8)-(GXloc, 319), 7, BF 'clear rest of list


  NoDriveSelection = 0

  fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
  LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B

' carve off any 'wildcard' from the specified input parameter

  Pattern$ = UCASE$(LTRIM$(RTRIM$(Pattern$)))
  str = Pattern$
  IF INSTR(str, "?") + INSTR(str, "*") = 0 THEN
   base$ = Pattern$
   wild$ = "*.*"
  ELSE
   IF MID$(str, 2, 1) = ":" THEN
    start = 3
   ELSE
    start = 1
   END IF
   DO
    i = INSTR(start, str, "\")
    IF i <> 0 THEN
     start = i + 1
    END IF
   LOOP UNTIL i = 0
   base$ = MID$(str, 1, start - 1)
   wild$ = MID$(RTRIM$(str), start)
  END IF

  CALL zzValidate(base$)
  IF base$ = "?" THEN
   base$ = ""
   CALL zzChangeDir(base$)
  END IF


  IF MID$(base$, LEN(base$)) = "\" THEN
   basex$ = MID$(base$, 1, LEN(base$) - 1)
  ELSE
   basex$ = base$
  END IF



' validate the "wildcard" portion

' (make sure no more than one ".")

  i = INSTR(wild$, ".")
  IF i <> 0 THEN
   x$ = wild$
   MID$(x$, i, 1) = "+"
   IF INSTR(x$, ".") THEN
    wild$ = "*.*"
    i = 2
   END IF
  END IF

' (divide it into its two component parts)

  IF i < 2 THEN
   wildl$ = wild$
   wildr$ = ""
  ELSE
   wildl$ = MID$(wild$, 1, i - 1)
   wildr$ = MID$(wild$, i + 1)
  END IF
  IF LEN(wildl$) > 8 OR LEN(wildr$) > 3 THEN
   wild$ = "*.*"
   wildl$ = "*"
   wildr$ = "*"
  END IF

' (make sure no more than one TRAILING "*" in left part)

  i = INSTR(wildl$, "*")
  IF i <> 0 THEN
   IF i <> LEN(wildl$) THEN
    wild$ = "*.*"
    wildl$ = "*"
    wildr$ = "*"
   END IF
  END IF

' (make sure no more than one TRAILING "*" in right part)

  i = INSTR(wildr$, "*")
  IF i <> 0 THEN
   IF i <> LEN(wildr$) THEN
    wild$ = "*.*"
    wildl$ = "*"
    wildr$ = "*"
   END IF
  END IF

  i = 39 - LEN(wild$) \ 2
  x$ = "[" + wild$ + "]"
  CALL ziPublishHere(7, i, x$, 0, 0)

' determine the specified drive

  dev = Devices(ASC(base$) - 64)
  GOSUB zzFileSelectBoxAA

' create the tree

  FOR i = 0 TO 11
   parts$(i) = ""
  NEXT
  x$ = basex$ + "\"

  levels = 0
  DO
   i = INSTR(x$, "\")
   IF i <> 0 THEN
    parts$(levels) = MID$(x$, 1, i - 1)
    levels = levels + 1
    x$ = MID$(x$, i + 1)
   END IF
  LOOP UNTIL i = 0
  parts$(0) = parts$(0) + "\"
  levels = levels - 1

  CALL ziPublishHere(12, 15, parts$(0), 0, 0)

  IF levels > 0 THEN
   FOR i = 1 TO levels
    x$ = SPACE$(i + i) + CHR$(179)
    CALL ziPublishHere(11 + i + i, 13, x$, 0, 0)
    x$ = SPACE$(i + i) + CHR$(192) + CHR$(196) + parts$(i)
    CALL ziPublishHere(12 + i + i, 13, x$, 0, 0)
   NEXT
  END IF

  oldtree = 255
  tree = levels
  GOSUB zzFileSelectBoxHH


' test for subdirectories present

  olddline = 0
  x$ = basex$ + "\*.*"
  CALL zzSearchD(x$)

  IF Directories <> 0 THEN
   fg = 8: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
   FromDir = 1
   GOSUB zzFileSelectBoxEE
  END IF

' test for files present

  x$ = basex$ + "\" + wild$
  CALL zzSearchF(x$)

  IF FileNames <> 0 THEN
   fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
   FromFile = 1
   GOSUB zzFileSelectBoxFF
  END IF

' determine where to start

  IF FileNames = 0 THEN
   IF Directories = 0 THEN
    fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
    Stuff$ = basex$ + "\"
    GOSUB zzFileSelectBoxDD
    Column = 2
   ELSE
    fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
    dline = 1
    GOSUB zzFileSelectBoxBB
    Stuff$ = basex$ + "\" + Directories$(FromDir)
    GOSUB zzFileSelectBoxDD
    Column = 4
   END IF

  ELSE
   fg = 4: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
   fline = 1
   GOSUB zzFileSelectBoxCC
   Column = 3
  END IF


' determine what to do, based on keystroke

  DO
   stroke$ = "X"
   DO
    stroke$ = INKEY$
   LOOP UNTIL LEN(stroke$) = 0
   DO
    stroke$ = INKEY$
   LOOP WHILE LEN(stroke$) = 0
   IF LEN(stroke$) = 1 THEN
    stroke$ = UCASE$(stroke$)
    SELECT CASE ASC(stroke$)
    CASE 27   'ESC
     Pattern$ = "?"
     RETURN
    CASE 13   'Enter
     SELECT CASE Column
     CASE 1    'enactivate new drive
      x$ = CHR$(validDevs(dev) + 64) + ":"
      Pattern$ = x$ + "\" + wild$
      LINE (112, 88)-(383, 319), 7, BF  'clear the "tree" area


      GOSUB zzFileSelectBoxII
      GOTO zzFileSelectBoxProcess

     CASE 2    'choose new directory
      IF tree <> levels THEN
       base$ = ""
       FOR i = 0 TO tree
    base$ = base$ + parts$(i)
    IF MID$(base$, LEN(base$)) <> "\" THEN
     base$ = base$ + "\"
    END IF
       NEXT
       IF MID$(base$, LEN(base$)) <> "\" THEN
    base$ = base$ + "\"
       END IF
       Pattern$ = base$ + wild$
       NoDriveSelection = 1
       GOSUB zzFileSelectBoxII
       GOTO zzFileSelectBoxProcess
      END IF


     CASE 3    'exit with chosen filename
      Pattern$ = Stuff$
      RETURN

     CASE 4    'choose new subdirectory
      Pattern$ = basex$ + "\" + Directories$(FromDir + dline - 1)
      Pattern$ = Pattern$ + "\" + wild$
      NoDriveSelection = 1
      GOSUB zzFileSelectBoxII
      GOTO zzFileSelectBoxProcess


     END SELECT

    CASE ASC("A") TO ASC("Z")
     SELECT CASE Column
     CASE 1
      i = ASC(stroke$) - 64
      IF Devices(i) <> 0 THEN
       dev = Devices(i)
       GOSUB zzFileSelectBoxAA
      END IF
     CASE 3
      i = FileNames
      x$ = MID$(FileNames$(i), 1, 1)
      IF x$ >= stroke$ THEN
       i = 0
       DO
    i = i + 1
    x$ = MID$(FileNames$(i), 1, 1)
       LOOP WHILE x$ < stroke$
      END IF
      FromFile = i
      GOSUB zzFileSelectBoxFF
      fline = 1: GOSUB zzFileSelectBoxCC

     CASE 4
      i = Directories
      x$ = MID$(Directories$(i), 1, 1)
      IF x$ >= stroke$ THEN
       i = 0
       DO
    i = i + 1
    x$ = MID$(Directories$(i), 1, 1)
       LOOP WHILE x$ < stroke$
      END IF
      FromDir = i
      GOSUB zzFileSelectBoxEE
      dline = 1: GOSUB zzFileSelectBoxBB

     END SELECT
    END SELECT
   ELSE
    SELECT CASE MID$(stroke$, 2)
    CASE "I"    'Page UP
     SELECT CASE Column
     CASE 3
      OldFromFile = FromFile
      IF FromFile + fline > 31 THEN
       FromFile = FromFile + fline - 31
      ELSE
       FromFile = 1
      END IF
      IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
      fline = 1: GOSUB zzFileSelectBoxCC
     CASE 4
      OldFromDir = FromDir
      IF FromDir + dline > 31 THEN
       FromDir = FromDir + dline - 31
      ELSE
       FromDir = 1
      END IF
      IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
      dline = 1: GOSUB zzFileSelectBoxBB
     END SELECT
    CASE "Q"    'Page DN
     SELECT CASE Column
     CASE 3
      OldFromFile = FromFile
      IF FromFile + fline + 30 < FileNames THEN
       FromFile = FromFile + fline + 29
       IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
       fline = 1: GOSUB zzFileSelectBoxCC
      END IF
     CASE 4
      OldFromDir = FromDir
      IF FromDir + dline + 30 < Directories THEN
       FromDir = FromDir + dline + 29
       IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
       dline = 1: GOSUB zzFileSelectBoxBB
      END IF
     END SELECT
    CASE "G"    'HOME
     SELECT CASE Column
     CASE 3
      IF FromFile <> 1 THEN
       FromFile = 1
       GOSUB zzFileSelectBoxFF
      END IF
      fline = 1: GOSUB zzFileSelectBoxCC
     CASE 4
      IF FromDir <> 1 THEN
       FromDir = 1
       GOSUB zzFileSelectBoxEE
      END IF
      dline = 1: GOSUB zzFileSelectBoxBB
     END SELECT
    CASE "O"    'END
     SELECT CASE Column
     CASE 3
      OldFromFile = FromFile
      FromFile = FileNames - 29
      IF FromFile < 1 THEN
       FromFile = 1
      END IF
      IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
      fline = 1: GOSUB zzFileSelectBoxCC
     CASE 4
      OldFromDir = FromDir
      FromDir = Directories - 29
      IF FromDir < 1 THEN
       FromDir = 1
      END IF
      IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
      dline = 1: GOSUB zzFileSelectBoxBB
     END SELECT
    CASE "H"    'UP
     SELECT CASE Column
     CASE 1     'drives
      IF dev > 1 THEN
       dev = dev - 1
       GOSUB zzFileSelectBoxAA
      END IF
     CASE 2     'tree
      IF tree > 0 THEN
       tree = tree - 1
       GOSUB zzFileSelectBoxHH
      END IF
     CASE 3     'files
      i = FromFile + fline - 2
      IF i > 0 THEN
       IF fline > 1 THEN
    fline = fline - 1
    GOSUB zzFileSelectBoxCC
       ELSE
    OldFromFile = FromFile
    FromFile = FromFile - 30
    fline = fline + 29
    IF FromFile < 1 THEN
     fline = fline + FromFile - 1
     FromFile = 1
    END IF
    IF OldFromFile <> FromFile THEN GOSUB zzFileSelectBoxFF
    GOSUB zzFileSelectBoxCC
       END IF
      END IF
     CASE 4     'subdirs
      i = FromDir + dline - 2
      IF i > 0 THEN
       IF dline > 1 THEN
    dline = dline - 1
    GOSUB zzFileSelectBoxBB
       ELSE
    OldFromDir = FromDir
    FromDir = FromDir - 30
    dline = dline + 29
    IF FromDir < 1 THEN
     dline = dline + FromDir - 1
     FromDir = 1
    END IF
    IF OldFromDir <> FromDir THEN GOSUB zzFileSelectBoxEE
    GOSUB zzFileSelectBoxBB
       END IF
      END IF
     END SELECT

    CASE "P"   'DOWN
     SELECT CASE Column
     CASE 1     'drives
      IF dev < MaxDevs THEN
       dev = dev + 1
       GOSUB zzFileSelectBoxAA
      END IF
     CASE 2     'tree
      IF tree < levels THEN
       tree = tree + 1
       GOSUB zzFileSelectBoxHH
      END IF
     CASE 3     'files
      i = FromFile + fline
      IF i <= FileNames THEN
       IF fline < 30 THEN
    fline = fline + 1
    GOSUB zzFileSelectBoxCC
       ELSE
    FromFile = i: GOSUB zzFileSelectBoxFF
    fline = 1: GOSUB zzFileSelectBoxCC
       END IF
      END IF
     CASE 4     'subdirs
      i = FromDir + dline
      IF i <= Directories THEN
       IF dline < 30 THEN
    dline = dline + 1
    GOSUB zzFileSelectBoxBB
       ELSE
    FromDir = i: GOSUB zzFileSelectBoxEE
    dline = 1: GOSUB zzFileSelectBoxBB
       END IF
      END IF
     END SELECT
    CASE "K"   'LEFT
     SELECT CASE Column
     CASE 2     'from TREE to DRIVES
      tree = levels
      GOSUB zzFileSelectBoxHH
      fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
      fg = 4: CALL ziPublishHere(8, 2, "Drives", 2, 1): fg = 0
      LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
      Column = 1
     CASE 3     'from FILES to TREE
      fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1)
      fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
      Column = 2
     CASE 4     'from SUBDIRS to ?
      dline = 0: GOSUB zzFileSelectBoxBB
      fg = 8: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 4
      IF FileNames = 0 THEN
       CALL ziPublishHere(8, 20, "Tree", 2, 1)
       Column = 2
      ELSE
       CALL ziPublishHere(8, 51, "Files", 2, 1)
       Column = 3
      END IF
      fg = 0
     END SELECT

    CASE "M"   'RIGHT
     SELECT CASE Column
     CASE 1     'from DRIVES to TREE
      dev = Devices(ASC(base$) - 64)
      GOSUB zzFileSelectBoxAA     'return to original drive
      fg = 8: CALL ziPublishHere(8, 2, "Drives", 2, 1)
      fg = 15: LINE (10, 7)-(Xmax - 10, Ymax - 7), 4, B
      fg = 4: CALL ziPublishHere(8, 20, "Tree", 2, 1): fg = 0
      Column = 2
     CASE 2     'from TREE to ?
      tree = levels
      GOSUB zzFileSelectBoxHH
      IF FileNames = 0 THEN
       IF Directories <> 0 THEN
    fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
    fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
    dline = 1: GOSUB zzFileSelectBoxBB
    Column = 4
       END IF
      ELSE
       fg = 8: CALL ziPublishHere(8, 20, "Tree", 2, 1)
       fg = 4: CALL ziPublishHere(8, 51, "Files", 2, 1): fg = 0
       Column = 3
      END IF
     CASE 3     'from FILES to SUBDIRS (if possible)
      IF Directories <> 0 THEN
       fg = 8: CALL ziPublishHere(8, 51, "Files", 2, 1)
       fg = 4: CALL ziPublishHere(8, 64, "Subdirs", 2, 1): fg = 0
       dline = 1: GOSUB zzFileSelectBoxBB
       Column = 4
      END IF
     END SELECT
    END SELECT
   END IF

  LOOP

'   ╔════════════════╗
'   ║      AA        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │         change the cursor bar on "dev"                      │
'    │                                                             │
'    │         input: dev   output: olddev                         │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxAA:
 IF dev <> olddev THEN
  FromRow = 10 + olddev + olddev
  ToRow = FromRow
  FromCol = 5
  ToCol = 10
  swap1 = bg: swap2 = fg
  IF olddev > 0 THEN
   GOSUB zzFileSelectBoxGG
  END IF
  FromRow = 10 + dev + dev
  ToRow = FromRow
  olddev = dev
  IF olddev > 0 THEN
   GOSUB zzFileSelectBoxGG
  END IF
 END IF
 RETURN



'   ╔════════════════╗
'   ║      BB        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │         change the cursor bar on "dline"                    │
'    │                                                             │
'    │         input: dline   output: olddline                     │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxBB:
 IF dline <> olddline THEN
  FromRow = 10 + olddline
  ToRow = FromRow
  FromCol = 67
  ToCol = 78
  swap1 = bg: swap2 = fg
  IF olddline > 0 THEN GOSUB zzFileSelectBoxGG
  FromRow = 10 + dline
  ToRow = FromRow
  olddline = dline
  IF dline > 0 THEN GOSUB zzFileSelectBoxGG
 END IF
 RETURN



'   ╔════════════════╗
'   ║      CC        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │         change the cursor bar on "fline"                    │
'    │                                                             │
'    │         input: fline   output: oldfline                     │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxCC:
 IF fline <> oldfline THEN
  FromRow = 10 + oldfline
  ToRow = FromRow
  FromCol = 51
  ToCol = 62
  swap1 = bg: swap2 = fg
  IF oldfline > 0 THEN
   GOSUB zzFileSelectBoxGG
  END IF
  FromRow = 10 + fline
  ToRow = FromRow
  oldfline = fline
  GOSUB zzFileSelectBoxGG
  Stuff$ = basex$ + "\" + FileNames$(FromFile + fline - 1)
  GOSUB zzFileSelectBoxDD
 END IF
 RETURN


'   ╔════════════════╗
'   ║      DD        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │     Determine middle of line for publishing "Stuff$"        │
'    │                                                             │
'    │                                                             │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxDD:
 LINE (38, 26)-(601, 46), 3, BF
 LINE (38, 26)-(601, 46), 8, B
 CALL ziPublishHere(5, 40 - LEN(Stuff$) \ 2, Stuff$, 1, 2)

 RETURN



'   ╔════════════════╗
'   ║      EE        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │         Show 30 subdirectories                              │
'    │                                                             │
'    │   input: FromDir                                            │
'    │                                                             │
'    │                                                             │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxEE:

 LINE (512, 80)-(Xmax - 11, 319), 7, BF
 IF FromDir > Directories THEN RETURN
 IF FromDir > 1 THEN
  fg = 4: CALL ziPublishHere(11, 65, CHR$(24), 0, 0): fg = 0
 END IF
 IF FromDir + 30 <= Directories THEN
  fg = 4: CALL ziPublishHere(40, 65, CHR$(25), 0, 0): fg = 0
  j = FromDir + 29
 ELSE
  j = Directories
 END IF

 FOR i = FromDir TO j
  k = INSTR(Directories$(i), ".")
  IF k = 0 THEN
   x$ = Directories$(i)
  ELSE
   x$ = MID$(Directories$(i), 1, k - 1) + SPACE$(8)
   x$ = MID$(x$, 1, 9) + MID$(Directories$(i), k + 1)
  END IF
  CALL ziPublishHere(11 + i - FromDir, 67, x$, 0, 1)
 NEXT
 olddline = 0

 RETURN


'   ╔════════════════╗
'   ║      FF        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │         Show 30 filenames                                   │
'    │                                                             │
'    │   input: FromFile                                           │
'    │                                                             │
'    │                                                             │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxFF:

 LINE (384, 80)-(495, 319), 7, BF
 IF FromFile > FileNames THEN RETURN
 IF FromFile > 1 THEN
  fg = 4: CALL ziPublishHere(11, 49, CHR$(24), 0, 0): fg = 0
 END IF
 IF FromFile + 30 <= FileNames THEN
  fg = 4: CALL ziPublishHere(40, 49, CHR$(25), 0, 0): fg = 0
  j = FromFile + 29
 ELSE
  j = FileNames
 END IF

 FOR i = FromFile TO j
  k = INSTR(FileNames$(i), ".")
  IF k = 0 THEN
   x$ = FileNames$(i)
  ELSE
   x$ = MID$(FileNames$(i), 1, k - 1) + SPACE$(8)
   x$ = MID$(x$, 1, 9) + MID$(FileNames$(i), k + 1)
  END IF
  CALL ziPublishHere(11 + i - FromFile, 51, x$, 0, 0)
 NEXT
 oldfline = 0

 RETURN


'   ╔════════════════╗
'   ║      GG        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │         Swap the colours (swap1 and swap2) of a region      │
'    │                                                             │
'    │  input: FromCol, FromRow, ToCol, ToRow, swap1, swap2        │
'    │                                                             │
'    │                                                             │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxGG:
 fx = FromCol * 8 - 8
 fy = FromRow * 8 - 8
 tx = ToCol * 8 - 1
 ty = ToRow * 8 - 1
 FOR ix = fx TO tx
  FOR iy = fy TO ty
   SELECT CASE POINT(ix, iy)
   CASE swap1
    PSET (ix, iy), swap2
   CASE swap2
    PSET (ix, iy), swap1
   END SELECT
  NEXT
 NEXT
 RETURN

'   ╔════════════════╗
'   ║      HH        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │         change the cursor bar on "tree"                     │
'    │                                                             │
'    │         input: tree   output: oldtree                       │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxHH:
 IF tree <> oldtree THEN
  FromRow = 12 + oldtree + oldtree
  ToRow = FromRow
  FromCol = 15 + oldtree + oldtree
  ToCol = FromCol + 11
  swap1 = bg: swap2 = fg
  IF oldtree <> 255 THEN
   GOSUB zzFileSelectBoxGG
  END IF
  FromRow = 12 + tree + tree
  ToRow = FromRow
  FromCol = 15 + tree + tree
  ToCol = FromCol + 11
  oldtree = tree
  GOSUB zzFileSelectBoxGG
 END IF
 RETURN


'   ╔════════════════╗
'   ║      II        ╟─────────────────────────────────────────────┐
'   ╚╤═══════════════╝                                             │
'    │         clear screen areas when changing directory          │
'    │                                                             │
'    │                                                             │
'    └─────────────────────────────────────────────────────────────┘
zzFileSelectBoxII:
 oldtree = 255
 oldfline = 0
 olddline = 0
 LINE (112, 16 * tree + 80)-(383, 319), 7, BF
 LINE (384, 56)-(495, 319), 7, BF
 LINE (504, 56)-(Xmax - 11, 319), 7, BF
 Stuff$ = "(Please Wait)"
 fg = 14: GOSUB zzFileSelectBoxDD: fg = 0
 RETURN

END SUB

'<p>
'++++++++++++++++++++++++
SUB zzInPath (Field$)

  x$ = ".;" + ENVIRON$("PATH")
  IF RIGHT$(x$, 1) <> ";" THEN x$ = x$ + ";"
  i = 1
  DO
    j = INSTR(i, x$, ";")
    IF j THEN
      y$ = UCASE$(MID$(x$, i, j - i))
      i = j + 1
      IF RIGHT$(y$, 1) <> "\" THEN y$ = y$ + "\"
      F$ = y$ + Field$
      Bad = 0
      OPEN "I", 1, F$
      IF Bad = 0 THEN
    CLOSE 1
    EXIT DO
      END IF
      F$ = ""
    END IF
  LOOP WHILE j
  Bad = 0
  Field$ = F$

END SUB

'<p>
'++++++++++++++++++++++++
SUB zzSearchD (Pattern$)

DIM str AS STRING * 65

 CALL zzCritOff
 GOSUB zzSearchDProcess
 CALL zzCritOn

 EXIT SUB

zzSearchDProcess:
  upperbound = UBOUND(Directories$)
  str = LTRIM$(RTRIM$(UCASE$(Pattern$)))
  Pattern$ = "?"

' clear the Directories$ array

 FOR i = 1 TO 500
  Directories$(i) = ""
 NEXT
 Directories = 0

' locate the DTA

 Regs.AX = &H2F00
 CALL zzBasicInt(&H21)
 DTAseg = Regs.ES
 DTAptr = Regs.BX

' confirm that the drive (if specified) is valid

 IF MID$(str, 2, 1) = ":" THEN
  i = ASC(str)
  IF i < 65 THEN RETURN
  IF i > 90 THEN RETURN
  Regs.AX = &H440E
  Regs.BX = i - 64
  CALL zzBasicInt(&H21)
  IF (Regs.FL AND 256) <> 256 THEN
   j = Regs.AX AND 255
   IF (j <> 0) AND (j <> i - 64) THEN
    i = j + 64
   END IF
  END IF
  Regs.AX = &H1C00
  Regs.DX = i - 64
  CALL zzBasicInt(&H21)
  IF (Regs.AX AND 255) = 255 THEN RETURN
 END IF

 x$ = RTRIM$(str)
 IF (x$ = "") OR (MID$(x$, 2) = ":") THEN
  x$ = x$ + "*.*"
 END IF
 IF (MID$(x$, LEN(x$)) = "\") THEN
  x$ = x$ + "*.*"
 END IF

 IF INSTR(x$, "*") + INSTR(x$, "?") = 0 THEN
  x$ = x$ + "\*.*"
 END IF

' initiate the search

 Pattern$ = x$
 str = x$ + CHR$(0)
 Regs.AX = &H4E00
 Regs.CX = &H10
 Regs.DS = VARSEG(str)
 Regs.DX = VARPTR(str)
 CALL zzBasicInt(&H21)

 DO WHILE (Regs.FL AND 256) = 0
  DEF SEG = DTAseg

' pull the name (letter by letter) from the DTA

  IF (PEEK(DTAptr + &H15) AND &H10) = &H10 THEN
   Name$ = ""
   i = &H1E
   DO
    j = PEEK(DTAptr + i)
    IF j <> 0 THEN
     Name$ = Name$ + CHR$(j)
    END IF
    i = i + 1
   LOOP UNTIL j = 0

' omit "." and ".."

   IF MID$(Name$, 1, 1) <> "." THEN
    Directories = Directories + 1
    IF Directories > upperbound THEN RETURN
    Directories$(Directories) = Name$
   END IF
  END IF

' keep going until all matches are found

  Regs.AX = &H4F00
  CALL zzBasicInt(&H21)
 LOOP

' now find the first byte of the directory pattern itself

 IF MID$(str, 2, 1) = ":" THEN
  start = 3
 ELSE
  start = 1
 END IF
 DO
  i = INSTR(start, str, "\")
  IF i <> 0 THEN
   start = i + 1
  END IF
 LOOP UNTIL i = 0
 x$ = MID$(str, 1, start - 1)
 CALL zzValidate(x$)
 IF MID$(x$, LEN(x$)) <> "\" THEN x$ = x$ + "\"
 i = INSTR(str, CHR$(0))

 Pattern$ = RTRIM$(x$ + MID$(str, start, i - start))

 IF Directories <> 0 THEN
  SortCount = Directories
  CALL zzAlphaSort(Directories$())
 END IF
 RETURN
END SUB

'<p>
'++++++++++++++++++++++++
SUB zzSearchF (Pattern$)

DIM str AS STRING * 65

 CALL zzCritOff
 GOSUB zzSearchFProcess
 CALL zzCritOn

 EXIT SUB

zzSearchFProcess:
 upperbound = UBOUND(FileNames$)
 str = LTRIM$(RTRIM$(UCASE$(Pattern$)))
 Pattern$ = "?"

' clear the FileNames$ array

 FOR i = 1 TO 500
  FileNames$(i) = ""
 NEXT
 FileNames = 0

' locate the DTA

 Regs.AX = &H2F00
 CALL zzBasicInt(&H21)
 DTAseg = Regs.ES
 DTAptr = Regs.BX

' confirm that the drive (if specified) is valid

 IF MID$(str, 2, 1) = ":" THEN
  i = ASC(str)
  IF i < 65 THEN RETURN
  IF i > 90 THEN RETURN
  Regs.AX = &H440E
  Regs.BX = i - 64
  CALL zzBasicInt(&H21)
  IF (Regs.FL AND 256) <> 256 THEN
   j = Regs.AX AND 255
   IF (j <> 0) AND (j <> i - 64) THEN
    i = j + 64
   END IF
  END IF
  Regs.AX = &H1C00
  Regs.DX = i - 64
  CALL zzBasicInt(&H21)
  IF (Regs.AX AND 255) = 255 THEN RETURN
 END IF

 x$ = RTRIM$(str)
 IF (x$ = "") OR (MID$(x$, 2) = ":") THEN
  x$ = x$ + "*.*"
 END IF
 IF (MID$(x$, LEN(x$)) = "\") THEN
  x$ = x$ + "*.*"
 END IF

 IF INSTR(x$, "*") + INSTR(x$, "?") = 0 THEN
  x$ = x$ + "\*.*"
 END IF

' initiate the search

 Pattern$ = x$
 str = x$ + CHR$(0)
 Regs.AX = &H4E00
 Regs.CX = &H27
 Regs.DS = VARSEG(str)
 Regs.DX = VARPTR(str)
 CALL zzBasicInt(&H21)

 DO WHILE (Regs.FL AND 256) = 0
  DEF SEG = DTAseg

' pull the name (letter by letter) from the DTA

  Name$ = ""
  i = &H1E
  DO
   j = PEEK(DTAptr + i)
   IF j <> 0 THEN
    Name$ = Name$ + CHR$(j)
   END IF
   i = i + 1
  LOOP UNTIL j = 0

  FileNames = FileNames + 1
  IF FileNames > upperbound THEN RETURN
  FileNames$(FileNames) = Name$

  Regs.AX = &H4F00
  CALL zzBasicInt(&H21)
 LOOP


' now find the first byte of the file pattern itself

 IF MID$(str, 2, 1) = ":" THEN
  start = 3
 ELSE
  start = 1
 END IF
 DO
  i = INSTR(start, str, "\")
  IF i <> 0 THEN
   start = i + 1
  END IF
 LOOP UNTIL i = 0
 x$ = MID$(str, 1, start - 1)
 CALL zzValidate(x$)
 IF MID$(x$, LEN(x$)) <> "\" THEN x$ = x$ + "\"
 i = INSTR(str, CHR$(0))

 Pattern$ = RTRIM$(x$ + MID$(str, start, i - start))

 IF FileNames <> 0 THEN
  SortCount = FileNames
  CALL zzAlphaSort(FileNames$())
 END IF
 RETURN
END SUB

'<p>
'++++++++++++++++++++++++
SUB zzValidate (Directory$)

DIM str AS STRING * 65

 CALL zzCritOff
 GOSUB zzValidateProcess
 CALL zzCritOn

 EXIT SUB

zzValidateProcess:

 Candpath$ = LTRIM$(RTRIM$(UCASE$(Directory$)))
 IF MID$(Candpath$, LEN(Candpath$)) = "\" THEN
  IF LEN(Candpath$) > 1 THEN
   IF MID$(Candpath$, 2) <> ":\" THEN
    Candpath$ = MID$(Candpath$, 1, LEN(Candpath$) - 1)
   END IF
  END IF
 END IF

 Directory$ = "?"

' check that any named drive is valid

 IF MID$(Candpath$, 2, 1) = ":" THEN
  i = ASC(MID$(Candpath$, 1, 1))
  IF i < 65 THEN RETURN
  IF i > 90 THEN RETURN
  Regs.AX = &H440E
  Regs.BX = i - 64
  CALL zzBasicInt(&H21)
  IF (Regs.FL AND 256) <> 256 THEN
   j = Regs.AX AND 255
   IF (j <> 0) AND (j <> i - 64) THEN
    i = j + 64
   END IF
  END IF
  Regs.AX = &H1C00
  Regs.DX = i - 64
  CALL zzBasicInt(&H21)
  IF (Regs.AX AND 255) = 255 THEN RETURN
 END IF

' handle special case of root directory

 IF Candpath$ = "\" THEN
  Directory$ = ""
  CALL zzChangeDrive(Directory$)
  Directory$ = Directory$ + "\"
  RETURN
 END IF
 IF MID$(Candpath$, 2) = ":\" THEN
  Directory$ = Candpath$
  RETURN
 END IF

' handle special case of NO directory

 IF Candpath$ = "" THEN
  CALL zzChangeDir(Candpath$)
  Directory$ = Candpath$
  RETURN
 END IF
 IF MID$(Candpath$, 2) = ":" THEN
  Regs.AX = &H4700
  Regs.DX = ASC(MID$(Candpath$, 1, 1)) - 64
  Regs.DS = VARSEG(str)
  Regs.SI = VARPTR(str)
  CALL zzBasicInt(&H21)
  i = INSTR(str, CHR$(0))
  Directory$ = Candpath$ + "\" + MID$(str, 1, i - 1)
  RETURN
 END IF

 str = Candpath$ + CHR$(0)
 IF INSTR(str, "*") + INSTR(str, "?") > 0 THEN RETURN


' initiate the search

 Regs.AX = &H4E00
 Regs.CX = &H10
 Regs.DS = VARSEG(str)
 Regs.DX = VARPTR(str)
 CALL zzBasicInt(&H21)

' abandon if not a valid directory

 IF (Regs.FL AND 256) <> 0 THEN RETURN
' locate the DTA

 Regs.AX = &H2F00
 CALL zzBasicInt(&H21)
 DTAseg = Regs.ES
 DTAptr = Regs.BX

 DEF SEG = DTAseg
 attr = PEEK(DTAptr + &H15)
 IF (attr AND &H10) = 0 THEN RETURN

' establish the status quo so that we can change back

 olddrv$ = ""
 CALL zzChangeDrive(olddrv$)

 IF MID$(str, 2, 1) = ":" THEN
  newdrv$ = MID$(str, 1, 2)
 ELSE
  newdrv$ = olddrv$
 END IF

 CALL zzChangeDrive(newdrv$)    'change to new drive
 olddir$ = ""
 CALL zzChangeDir(olddir$)      'find the current directory on new drive
 CALL zzChangeDir(str)          'change to the desired directory
 CALL zzChangeDir(olddir$)      'change back to the current directory
 CALL zzChangeDrive(olddrv$)    'change back to old drive
 IF Root = 0 THEN
  Directory$ = RTRIM$(str)
 ELSE
  Directory$ = MID$(str, 1, 2) + "\"
 END IF
 RETURN

END SUB